home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / fb386 / game / puz / puz.bas < prev    next >
BASIC Source File  |  1995-02-15  |  11KB  |  296 lines
  1. 10000 *START
  2. 10010 DIM SNE(1632),PNE(342),WWIN(9888),SNU(532),PNU(342),WNUM(5400),WYNO(2700),A(1000),B(5400)
  3. 10020 ON KEY(10) GOSUB *CP_START:KEY(10) ON:CP_X=100:CP_Y=100
  4. 10030 CLS:SCREEN 1,0,2:LOAD@"puz.tif":COLOR 2,%15
  5. 10040 GET@A(69,20)-(160,88),SNE
  6. 10050 GET@A(177,20)-(246,39),PNE
  7. 10060 GET@A(69,0)-(176,19),SNU
  8. 10070 GET@A(177,0)-(246,19),PNU
  9. 10080 GET@A(200,150)-(434,240),WNUM
  10. 10090 GET@A(0,150)-(189,356),WWIN
  11. 10100 GET@A(200,250)-(383,306),WYNO
  12. 10110 LINE(0,20)-(639,479),PSET,%6,BF:SCREEN 1,0,3
  13. 10120 NX=176:NY=100
  14. 10130 SX=200:SY=200:SX=100:SY=50
  15. 10140 MOUSE 0
  16. 10150  FOR I=0 TO 1:A$(I)="":READ D$:FOR J=0 TO 31
  17. 10160   A$(I)=A$(I)+CHR$(VAL("&h"+MID$(D$,J*2+1,2)))
  18. 10170  NEXT:NEXT:MOUSE 2,A$(0),A$(1),0,0
  19. 10180 MOUSE 1,320,240,1
  20. 10190 DATA 7FFF3FFF1FFF07FF03FF01FF00FF007F003F001F007F00FF107F387FF87FFC7F
  21. 10200 DATA 000000004000200058003C005E002F005F805400460002000300010000000000
  22. 10210 *LOOP
  23. 10220 DATA 0,68,69,176,177,246,587,606,610,629,999,999
  24. 10230  WHILE NOT MOUSE(2,0):WEND
  25. 10240 X=MOUSE(4,0):Y=MOUSE(5,0)
  26. 10250 IF Y>19 THEN *MOVS
  27. 10260 RESTORE *LOOP
  28. 10270  I=0:A=0:WHILE A<>999:I=I+1:READ A,B
  29. 10280   IF A=<X AND X<=B THEN A=999
  30. 10290  WEND
  31. 10300 ON I GOSUB *CP_START,*INPUZ,*PRT,*CP_START,*END
  32. 10310  WHILE MOUSE(2,0):WEND
  33. 10320 GOTO *LOOP
  34. 10330 *PRT
  35. 10340 PUT@A(177,20)-(246,39),PNE
  36. 10350 LINE(177,0)-(246,19),PSET,%1,B
  37. 10360 LINE(178,1)-(245,18),PSET,%1,B
  38. 10370  WHILE MOUSE(2,0):GOSUB *PRT_MOV:WEND
  39. 10380 X=MOUSE(7,0):Y=MOUSE(8,0)
  40. 10390 IF 177<X AND X<246 AND 20<Y AND Y<34 THEN *PRT_MOS
  41. 10400  WHILE NOT MOUSE(2,0):GOSUB *PRT_MOV:WEND
  42. 10410 X=MOUSE(4,0):Y=MOUSE(5,0)
  43. 10420 IF 177<X AND X<246 AND 20<Y AND Y<34 THEN *PRT_MOS
  44. 10430 LINE(177,20)-(246,39),PSET,%6,BF
  45. 10440 PUT@A(177,0)-(246,19),PNU
  46. 10450 RETURN
  47. 10460 *PRT_MOV
  48. 10470 X=MOUSE(0):Y=MOUSE(1)
  49. 10480 IF X<68 OR 177<X OR 20<Y THEN *PRT_MOVS
  50. 10490 LINE(177,20)-(246,39),PSET,%6,BF
  51. 10500 PUT@A(177,0)-(246,19),PNU
  52. 10510 GOTO *INPUZ
  53. 10520 *PRT_MOVS
  54. 10530 IF 177>X OR X>246 OR 20>Y OR Y>34 THEN RETURN
  55. 10540 IF POINT(179,21)=-1 THEN RETURN
  56. 10550 LINE(179,21)-(242,35),XOR,%8,BF
  57. 10560 RETURN
  58. 10570 *PRT_MOS
  59. 10580 LINE(177,20)-(246,39),PSET,%6,BF
  60. 10590 PUT@A(177,0)-(246,19),PNU
  61. 10600 GET@A (230,220)-(413,276),B
  62. 10610 PUT@A (230,220)-(413,276),WYNO
  63. 10620 GET@A (236,226)-(337,242),A
  64. 10630 LINE (236,226)-(408,242),PSET,%15,BF
  65. 10640 PUT@A (270,226)-(371,242),A
  66. 10650 GOSUB *YNO_LOOP
  67. 10660 'IF K=0 THEN HARDC 3,(SX+2,SY+19)-(SX+185,SY+202)
  68. 10670 IF K=0 THEN SAVE@"puzdata.tif",(SX+2,SY+19)-(SX+185,SY+202)
  69. 10680 PUT@A (230,220)-(413,276),B
  70. 10690 RETURN
  71. 10700 *MOVS
  72. 10710 IF X>SX+1 AND X<SX+16 AND Y>SY+1 AND Y<SY+16 THEN *DELWIN
  73. 10720 IF X>SX+18 AND X<SX+188 AND Y>SY+1 AND Y<SY+16 THEN *MOVWIN
  74. 10730 GOTO *LOOP
  75. 10740 *DELWIN
  76. 10750 LINE (SX+1,SY+1)-STEP(15,15),XOR,,BF
  77. 10760 WHILE MOUSE(2,0):WEND
  78. 10770 LINE (SX,SY)-STEP(189,206),PSET,%6,BF
  79. 10780 GOTO *LOOP
  80. 10790 *MOVWIN
  81. 10800 MOUSE 1,,,0:MX=SX:MY=SY
  82. 10810 WHILE MOUSE(2,0)
  83. 10820  X=MOUSE(9)+MX:Y=MOUSE(10)+MY
  84. 10830  X=X*(X<0)-(450-X)*(X>450)+X:Y=-(20-Y)*(Y<20)-(273-Y)*(Y>273)+Y
  85. 10840  LINE (X,Y)-STEP(189,206),XOR,%13,B
  86. 10850  LINE (X,Y)-STEP(189,206),XOR,%13,B
  87. 10860  MX=X:MY=Y
  88. 10870 WEND:MOUSE 1,,,1
  89. 10880 GET@A(SX,SY)-(SX+189,SY+206),WWIN
  90. 10885 LINE (SX,SY)-(SX+189,SY+206),PSET,%6,BF
  91. 10890 SX=X:SY=Y
  92. 10900 PUT@A(SX,SY)-(SX+189,SY+206),WWIN
  93. 10910 GOTO *LOOP
  94. 10920 *END
  95. 10930 GET@A (230,220)-(413,276),B
  96. 10940 PUT@A (230,220)-(413,276),WYNO
  97. 10950 GET@A (344,226)-(408,242),A
  98. 10960 LINE (236,226)-(408,242),PSET,%15,BF
  99. 10970 PUT@A (288,226)-(352,242),A
  100. 10980 GOSUB *YNO_LOOP
  101. 10990 PUT@A (230,220)-(413,276),B
  102. 11000 IF K=0 THEN MOUSE 5:END
  103. 11010 RETURN
  104. 11020 *YNO_LOOP
  105. 11030  K=0:WHILE MOUSE(2,0):WEND
  106. 11040  WHILE NOT MOUSE(2,0):WEND
  107. 11050  X=MOUSE(4,0):Y=MOUSE(5,0)
  108. 11060  IF Y<251 OR Y>269 OR X<293 OR X>407 THEN *YNO_LOOP
  109. 11070  IF X>344 AND X<356 THEN *YNO_LOOP
  110. 11080  K=(X-293)\60
  111. 11090 LINE(294+K*63,252)-STEP(49,16),XOR,%8,BF
  112. 11100 WHILE MOUSE(2,0):WEND
  113. 11110 LINE(294+K*63,252)-STEP(49,16),XOR,%8,BF
  114. 11120 IF NOT (MOUSE(7,0)=X AND MOUSE(8,0)=Y) THEN *YNO_LOOP
  115. 11130 RETURN
  116. 11140 *INPUZ
  117. 11150 PUT@A(69,20)-(160,88),SNE
  118. 11160 LINE(69,0)-(176,19),PSET,%1,B
  119. 11170 LINE(70,1)-(175,18),PSET,%1,B
  120. 11180  WHILE MOUSE(2,0):GOSUB *INPUZ_MOV:WEND
  121. 11190 X=MOUSE(7,0):Y=MOUSE(8,0)
  122. 11200 IF 69<X AND X<160 AND 20<Y AND Y<83 THEN *INPUZ_MOS
  123. 11210  WHILE NOT MOUSE(2,0):GOSUB *INPUZ_MOV:WEND
  124. 11220 X=MOUSE(4,0):Y=MOUSE(5,0)
  125. 11230 IF 69<X AND X<160 AND 20<Y AND Y<83 THEN *INPUZ_MOS
  126. 11240 LINE(69,20)-(160,88),PSET,%6,BF
  127. 11250 PUT@A(69,0)-(176,19),SNU
  128. 11260 RETURN
  129. 11270 *INPUZ_MOV
  130. 11280 X=MOUSE(0):Y=MOUSE(1)
  131. 11290 IF X<176 OR 247<X OR 20<Y THEN *INPUZ_MOVS
  132. 11300 LINE(69,20)-(160,88),PSET,%6,BF
  133. 11310 PUT@A(69,0)-(176,19),SNU
  134. 11320 GOTO *PRT
  135. 11330 *INPUZ_MOVS
  136. 11340 IF X<69 OR 160<X OR Y<20 OR 83<Y THEN RETURN
  137. 11350 Y=((Y-20)\16)*16+21
  138. 11360 IF POINT(71,Y)=-1 THEN RETURN
  139. 11370 PUT@A(69,20)-(160,88),SNE
  140. 11380 LINE(71,Y)-STEP(85,14),XOR,%8,BF
  141. 11390 RETURN
  142. 11400 *INPUZ_MOS
  143. 11410 DATA 103,sl,39,nl,70,nu,60,bo,0,e
  144. 11420 R=(Y-20)\16+1:RESTORE *INPUZ_MOS
  145. 11430  FOR I=1 TO R:READ NA,NA$:I=I-R*(NA$="e"):NEXT
  146. 11440 IF NA$="e" THEN *INPUZ
  147. 11450 OPEN "("+MID$(STR$(NA),2)+")pu_"+NA$+".pzd" AS #1
  148. 11460 L=LOF(1):CLOSE #1
  149. 11470 PUT@A(NX,NY)-(NX+234,NY+90),WNUM:A=1
  150. 11480 SYMBOL(NX+110,NY+30)," 1",2,1,0
  151. 11490 *INPUZ_LOOP
  152. 11500 DATA 20,32,61,45,65,32,84,45,149,32,168,45
  153. 11510 DATA 172,32,213,45,109,58,160,76,172,58,223,76
  154. 11520  K=0:WHILE K<5
  155. 11530   WHILE MOUSE(2,0):WEND
  156. 11540   WHILE NOT MOUSE(2,0):WEND
  157. 11550   X=MOUSE(4,0):Y=MOUSE(5,0):RESTORE *INPUZ_LOOP:K=0
  158. 11560    FOR I=1 TO 6
  159. 11570     READ X1,Y1,X2,Y2
  160. 11580     K=K-(X1+NX<X AND X<X2+NX AND Y1+NY<Y AND Y<Y2+NY)*I
  161. 11590    NEXT
  162. 11600   M=K*9-19+7*(K>2)
  163. 11610   IF 0<K AND K<5 THEN A=A+M
  164. 11620   A=-(A-1)*(A>0)+1:A=-(A-L)*(A<L)+L
  165. 11630   LINE(NX+110,NY+30)-STEP(32,16),PRESET,%15,BF
  166. 11640   SYMBOL(NX+110,NY+30),RIGHT$(STR$(A),2),2,1,0
  167. 11650  WEND
  168. 11660 LINE(NX+K*63-205,NY+59)-STEP(49,16),XOR,%8,BF
  169. 11670 WHILE MOUSE(2,0):WEND
  170. 11680 LINE(NX+K*63-205,NY+59)-STEP(49,16),XOR,%8,BF
  171. 11690 IF NOT (MOUSE(7,0)=X AND MOUSE(8,0)=Y) THEN *INPUZ_LOOP
  172. 11700 LINE(NX,NY)-STEP(234,90),PSET,%6,BF
  173. 11710 LINE(69,20)-(160,88),PSET,%6,BF
  174. 11720 PUT@A(69,0)-(176,19),SNU
  175. 11730 IF K-6 THEN *INPUZ_PUT
  176. 11740 LINE(69,20)-(160,88),PSET,%6,BF
  177. 11750 PUT@A(69,0)-(176,19),SNU
  178. 11760 RETURN
  179. 11770 *INPUZ_PUT
  180. 11780 OPEN "("+MID$(STR$(NA),2)+")pu_"+NA$+".pzd" AS #1
  181. 11790 FIELD #1,NA-2 AS DA$
  182. 11800 GET #1,A:CLOSE #1
  183. 11810 PUT@A(SX,SY)-(SX+189,SY+206),WWIN
  184. 11820 LINE (SX+3,SY+20)-STEP(181,181),PSET,%15,BF
  185. 11830 ON R GOSUB *LOAD_SL,*LOAD_NL,*LOAD_NU,*LOAD_BO
  186. 11840 GOTO *LOOP
  187. 11850 *LOAD_SL
  188. 11860  FOR I=0 TO 99:X=I MOD 10:Y=I \ 10:R=VAL(MID$(DA$,I+1,1))
  189. 11865   LINE (SX+X*18+3,SY+Y*18+20)-STEP(1,1),PSET,%0,BF
  190. 11870   IF R=5 THEN NEXT:RETURN
  191. 11880   SYMBOL(SX+X*18+5,SY+Y*18+22),MID$(STR$(R),2),2,1,0
  192. 11890  NEXT
  193. 11891  FOR I=0 TO 10:LINE (SX+183,SY+I*18+20)-STEP(1,1),PSET,%0,BF:NEXT
  194. 11893  FOR I=0 TO 9:LINE (SX+I*18+3,SY+200)-STEP(1,1),PSET,%0,BF:NEXT
  195. 11895 RETURN
  196. 11900 *LOAD_NL
  197. 11910 GOSUB *PUT_MAS
  198. 11920  I=0:WHILE VAL(MID$(DA$,I*4+1,4))<>0
  199. 11930   X=VAL(MID$(DA$,I*4+1,1))
  200. 11940   Y=VAL(MID$(DA$,I*4+2,1))
  201. 11950   SYMBOL(SX+X*18+5,SY+Y*18+22),MID$(STR$(I+1),2),2,1,0
  202. 11960   X=VAL(MID$(DA$,I*4+3,1))
  203. 11970   Y=VAL(MID$(DA$,I*4+4,1))
  204. 11980   SYMBOL(SX+X*18+5,SY+Y*18+22),MID$(STR$(I+1),2),2,1,0
  205. 11990  I=I+1:WEND
  206. 12000 RETURN
  207. 12010 *LOAD_NU
  208. 12020 GOSUB *PUT_MAS
  209. 12030  C=0:WHILE MID$(DA$,C*4+1,1)<>" "
  210. 12040   X=VAL(MID$(DA$,C*4+1,1)):Y=VAL(MID$(DA$,C*4+2,1))
  211. 12050   R=VAL(MID$(DA$,C*4+3,2))
  212. 12060   SYMBOL(SX+X*18+5,SY+Y*18+22),MID$(STR$(R),2),-(R<10)+1,1,0
  213. 12070  C=C+1:WEND
  214. 12080 RETURN
  215. 12090 *LOAD_BO
  216. 12100 GOSUB *PUT_MAS
  217. 12110  C=0:I=-1:WHILE MID$(DA$,C*2+1,1)<>" "
  218. 12120   I=I+VAL("&H"+MID$(DA$,C*2+1,1))+1:X=I MOD 10:Y=I \ 10
  219. 12130   R=VAL("&H"+MID$(DA$,C*2+2,1))
  220. 12140   SYMBOL(SX+X*18+5,SY+Y*18+22),MID$(STR$(R),2),-(R<10)+1,1,0
  221. 12150  C=C+1:WEND
  222. 12160 RETURN
  223. 12170 *PUT_MAS
  224. 12180 FOR I=0 TO 10
  225. 12190  LINE (SX+I*18+3,SY+20)-STEP(1,181),PSET,0,B
  226. 12200  LINE (SX+3,SY+I*18+20)-STEP(181,1),PSET,0,B
  227. 12210 NEXT
  228. 12220 RETURN
  229. 12230 *CP_START
  230. 12240 ON ERROR GOTO *CP_ERR
  231. 12250 CP_MMX!=MOUSE(0):CP_MMY!=MOUSE(1)
  232. 12260 DIM CP_BA!(71):MOUSE 1,,,1
  233. 12270 MOUSE 4,CP_X!,CP_Y!,CP_X!+23,CP_Y!+16
  234. 12280 GET@A (CP_X!,CP_Y!)-(CP_X!+25,CP_Y!+17),CP_BA!
  235. 12290  LINE (CP_X!,CP_Y!)-STEP(25,17),PSET,7,BF
  236. 12300  LINE (CP_X!,CP_Y!)-STEP(25,17),PSET,0,B
  237. 12310  LINE (CP_X!,CP_Y!)-STEP(8,8),PSET,0,B
  238. 12320  LINE (CP_X!,CP_Y!+8)-STEP(8,9),PSET,0,B
  239. 12330  LINE (CP_X!+2,CP_Y!+2)-STEP(4,4),PSET,0,B
  240. 12340  LINE (CP_X!+2,CP_Y!+10)-STEP(0,5),PSET,0
  241. 12350  LINE (CP_X!+2,CP_Y!+10)-STEP(4,2),PSET,0
  242. 12360  LINE (CP_X!+2,CP_Y!+15)-STEP(4,-2),PSET,0
  243. 12370 CDINF CP_IN%:CDSTAT CP_ST%
  244. 12380 CP_ST!=CP_ST%(5)-(CP_ST%(1)=0)
  245. 12390 IF CP_ST%(1) THEN LINE (CP_X!+1,CP_Y!+9)-STEP(6,7),XOR,7,BF
  246. 12400 *CP_LOOP
  247. 12410 CDSTAT CP_ST%
  248. 12420 LINE(CP_X!+9,CP_Y!+1)-STEP(15,15),PSET,7,BF
  249. 12430 SYMBOL (CP_X!+9,CP_Y!+1),RIGHT$(STR$(CP_ST!),2),1,1,0
  250. 12440 WHILE MOUSE(2,0) OR MOUSE(2,1):CDSTAT CP_ST%:WEND
  251. 12450 WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:CDSTAT CP_ST%:WEND
  252. 12460 IF MOUSE(2,1) THEN *CP_END
  253. 12470 CP_MX!=MOUSE(4,0)-CP_X!:CP_MY!=MOUSE(5,0)-CP_Y!-1
  254. 12480 CP_R=CP_MX!\8+(CP_MY!\8)*3
  255. 12490 IF CP_MY!=-1 THEN *CP_MOV
  256. 12500 CP_ST!=CP_ST!+(CP_R=1 OR CP_R=4)-(CP_R=2 OR CP_R=5)
  257. 12510 CP_ST!=CP_ST!+(CP_ST!>CP_IN%(5))-(CP_ST!<1)
  258. 12520 IF CP_ST!<>CP_ST%(5) AND CP_ST%(1)=1 THEN *CP_PL
  259. 12530 IF CP_R=0 AND CP_ST%(1)=1 THEN *CP_ST
  260. 12540 IF CP_R=3 AND CP_ST%(1)=0 THEN *CP_PL
  261. 12550 GOTO *CP_LOOP
  262. 12560 *CP_PL
  263. 12570 IF CP_IF%(1)>1 AND CP_ST%(1)=1 THEN GOTO *CP_LOOP
  264. 12580 IF CP_ST%(1)=0 THEN LINE (CP_X!+1,CP_Y!+9)-STEP(6,7),XOR,7,BF
  265. 12590 CD PLAY CP_ST!:GOTO *CP_LOOP
  266. 12600 *CP_ST
  267. 12610 LINE (CP_X!+1,CP_Y!+9)-STEP(6,7),XOR,7,BF
  268. 12620 CD STOP:GOTO *CP_LOOP
  269. 12630 *CP_NODISK
  270. 12640 IF CP_ST!>-1 THEN LINE(CP_X!,CP_Y!)-STEP(25,17),XOR,7,BF
  271. 12650 IF MOUSE(2,1) THEN *CP_END
  272. 12660 CP_ST!=-1
  273. 12670 CDINF CP_IN%:CDSTAT CP_ST%
  274. 12680 CP_ST!=CP_ST%(5)-(CP_ST%(1)=0)
  275. 12690 LINE(CP_X!,CP_Y!)-STEP(25,17),XOR,7,BF
  276. 12700 GOTO *CP_LOOP
  277. 12710 *CP_MOV
  278. 12720 ON ERROR GOTO 0:MOUSE 4,25,0,614,462
  279. 12730 CP_MX!=MOUSE(9):CP_MY!=MOUSE(10):CP_MX!=CP_X!:CP_MY!=CP_Y!
  280. 12740 WHILE MOUSE(2,0)
  281. 12750 LINE(CP_MX!,CP_MY!)-STEP(25,17),XOR,7,B
  282. 12760 CP_MX!=CP_MX!+MOUSE(9):CP_MY!=CP_MY!+MOUSE(10)
  283. 12770 LINE(CP_MX!,CP_MY!)-STEP(25,17),XOR,7,B
  284. 12780 WEND
  285. 12790 LINE(CP_MX!,CP_MY!)-STEP(25,17),XOR,7,B
  286. 12800 PUT@A (CP_X!,CP_Y!)-(CP_X!+25,CP_Y!+17),CP_BA!
  287. 12810 CP_X!=CP_MX!:CP_Y!=CP_MY!:GOTO *CP_START
  288. 12820 *CP_ERR
  289. 12830 IF ERR=53 THEN RESUME *CP_NODISK
  290. 12840 IF ERR=10 THEN RESUME NEXT
  291. 12850 PRINT ERR,ERL:ERROR ERR
  292. 12860 *CP_END
  293. 12870 PUT@A (CP_X!,CP_Y!)-(CP_X!+25,CP_Y!+17),CP_BA!
  294. 12880 MOUSE 4,0,0,639,479:MOUSE 1,CP_MMX!,CP_MMY!,1
  295. 12890 RETURN
  296.